مطالب وبلاگ

به قسمت های دیگر هم سر بزنید...

• بازی های VB6
• برنامه های کاربردی با vb
• کد سورس
• کامپوننت(OCX,DLL)
• بخش کننده با VB6
• انواع API
• اینترنت و vb
• بانک اطلاعات در vb
• آموزشی

Www.Vb6.loxblog.ir

ارتباط با ما

قرار دادن فرم در با لای تمام فرم ها

به روش زیر عمل کنید تا فرمتون در بالای تمامی ژنجره ها قرار گیرد..

Private Declare Sub SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)

توی فرم لود..

SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 83

برنامه رو اجرا کنید...

موفق باشید

API Text Viewer

این برنامه حاوی ۲۰۰ تابع API موفید برای کسانی که در حال یادگیری

کار با API هستند....

دانلود با حجم ۱۷۵

رمز : vb6

نمایش درایو های موجود

به روش زیر عمل کنید....

Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

--------------------------------------------------------------------------------------------------

Private Sub Form_Load()
     Dim StrBuffer As String
     Me.AutoRedraw = True
     StrBuffer = String(255, Chr$(0))
     ret& = GetLogicalDriveStrings(255, StrBuffer)
     For I = 1 To 100
            If  Left$(StrBuffer, InStr(1, StrBuffer, Chr$(0))) = Chr$(0) Then  Exit For
            Me.Print Left$(StrBuffer, InStr(1, StrBuffer, Chr$(0)) – 1)
            StrBuffer = Right$(StrBuffer, Len(StrBuffer) - InStr(1, StrBuffer, Chr$(0)))
     Next I
End Sub

موفق باشید...

جستوجوی یک فایل

برای این کار به روش زیر عمل کنید

Public  Declare  Function  SearchTreeForFile  Lib  "imagehlp"  (ByVal  RootPath  As  String,  ByVal
InputPathName As String, ByVal OutputPathBuffer As String) As Long
Public Const MAX_PATH = 260

---------------------------------------------------------------------------------------------------

Private Sub Form_Load()
     Dim TempStr As String
     Dim Result As Long
     TempStr = String(MAX_PATH, 0)
     Result = SearchTreeForFile("C:\", "Ali.txt", TempStr)
     If  Result <> 0 Then
          MsgBox "Located file at " + Left$(TempStr, InStr(1, TempStr, Chr$(0)) – 1)
     Else
           MsgBox " File not found "
     End If
End Sub

موفق باشید....

سلام : بازم با یه برنامه ی جدید اومدم

کدی برای حرکت در آوردن فرم با کلیک روی لیبل

که توی برنامه هاتون می تونین ازش استفاده کنین....

دانلود با حجم ۴۰ کیلو بایت

رمز:vb6

به روش زیر عمل کنید

Public Declare Function timeGetTime Lib "winmm.dll" () As Long

بعد از معرفی تابع بالادستور زیر رادر یک دکمه بنویسید

Dim A as Long
Private Sub Command1_Click()
     A = timeGetTime
     Text1.Text = A
End Sub

موفق باشید

API تغییر برجسب درایو

این ای پی ای نام برچسب داریو شما را تغییر می دهد

برای این منظور دستور زیر را در یک ماژول بنویسد

Public Declare Function SetVolumeLabelA  Lib "kernel32.dll" (ByVal lpRootName  As String,
ByVal lpVolumeName As String) As Long

 : lpRootName مسیر پوشه:مثل درایو :\C

VolumeNameنام برچسب "ویژالبیسیک"

بعد دستور زیر را در یک دکمه یا فرم لود بنویسید

Dim A As Long
     Private Sub Commad1_Click()
     A = SetVolumeLabelA("C:\", "VisualBasic")
End Sub

موفق باشید

منتظر API بعدی باشید

نمایش نام کاربری

برای انجام این کار یم تکست در فرم بگزارید و

API زیر رو در جنرال بنویسید

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

برای نمایش ان بر روی فرم دبل کلیک کرده و دستور زیر را بنویسید

Dim Buffer As String
Buffer = String(255, 0)
GetUserName Buffer, 255
Buffer = Left(Buffer, InStr(Buffer, Chr(0)) - 1)
Text1 = Buffer

سعی می کنمAPI بیشتری رو بزارم فعلا بای...

تغییر زبان صفحه کلید

برای این کار دستور زیر را در جنرال بنویسید

Private Const HKL_NEXT = 1
Private Const HKL_PREV = 0

Private Declare Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As Long, ByVal flags As Long) As Long
Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long

Dim oldKB As Long

بعدش دستور زیر را برای دکمه تغییر به فارسی بنویسید

    oldKB = GetKeyboardLayout(0)
    ActivateKeyboardLayout HKL_NEXT, ByVal 0&

این هم برای برگرداندنش

    ActivateKeyboardLayout oldKB, ByVal 0&

خیلی آسونه نه

شنیدن صدای بوق سیستم

برای این کار لازمه API زیر را بار گذاری کنید

Private Declare Function MessageBeep Lib "user32" (ByVal wType As Long) As Long

و دستور زیر را برای یه دکمه بنویسید...

    Dim Beeper As Variant
    Beeper = MessageBeep(-1)

به همین سادگی آره

تبدیل بایت به کیلو بایت

این برنامه خیلی خیلی جالبه...

برای ساخت اون نیاز به ۲ کادر متن و یک دکمه دارید...

API زیر را بارگذاری کنید

Private Declare Function StrFormatByteSize Lib "shlwapi" Alias "StrFormatByteSizeA" (ByVal dw As Long, ByVal pszBuf As String, ByRef cchBuf As Long) As String

دستور زیر رو هم در جنرال بالای ای پی ای بنویسید...

Option Explicit

برای دکمه دستور زیر را نوشته و برنامه را اجرا کنید

On Error Resume Next
    Dim Buffer As String
    Dim Result As String
    Buffer = Space$(255)
    Result = StrFormatByteSize(Text1.Text, Buffer, Len(Buffer))

    If InStr(Result, vbNullChar) > 1 Then
        Text2.Text = Left$(Result, InStr(Result, vbNullChar) - 1)
    End If

موفق باشید

نظر بدین

شما را به خدا

نظر بدین

برای این کار ۱ کنترل تایمر روی فرم بذارید و     Timer1.Interval = 300 بزارید

و API زیر را باز کرده و در جنرال بنویسید

Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long

برای تایمر دستور زیر را بنویسید....

    FlashWindow hwnd, 1

حالا برنامه رو اجرا کنید و نتیجه رو ببینید...

موفق باشید

نظر هم بدین

نظر ندین ناراحت می شم

نمایش Resolutions سیستم

برای این کار API زیر را باز کنید

Private Declare Function GetSystemMetrics Lib "User32" (ByVal index As Long) As Long

دستور زیر را به همراه API در جنرال بنویسید

Dim X As Long, Y As Long

برای دکمه یا هر چیز دیگری دستور زیر را بنویسید....

    X = GetSystemMetrics(0)
    Y = GetSystemMetrics(1)

    MsgBox "Resolutions is : " & CStr(X) & " X " & CStr(Y), vbExclamation, "Monitor"

....موفق باشد...

نظر بدین

برای پنهان سازی آیکون های دسکتاپ

شما باید ۲ API زیر را باز کنید...

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long

بعد از باز کرد API بالا ۲ دکمه بر روی فرم بذارید...یکی برای پنهان سازی و یکی برای

نمایش مجدد...

برای پنهان سازی دستور زیر را بنویسید...

   Dim hWnd As Long

    hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString)
        ShowWindow hWnd, 0

و برای نمایش مجدد کد زیر را وارد کنید.....

   Dim hWnd As Long

    hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString)
       ShowWindow hWnd, 5

تا یادم نرفته توی جنرال این رو هم بنویسین...

Option Explicit

...ممنون از شما...

....نظر هم بدین....